perm filename DEKODE.F4[M11,LCS] blob sn#404805 filedate 1978-12-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE DEKODE(KODE)
C00007 ENDMK
C⊗;
	SUBROUTINE DEKODE(KODE)
      DIMENSION M(80),VV(4)
      COMMON J
      COMMON  /ALPH/IALPH(14)
     1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
     1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	DATA KSLA/'/'/
	1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
	1,'Y'/
	EQUIVALENCE (M,INP),(VV,VX)
	EQUIVALENCE (IEE,ISCA(5)),(IDD,ISCA(3)),(IMM,IALPH(6))
	1,(ITT,ISCA(11)),(III,IALPH(2)),(IYY,IALPH(14)),
	1(INN,IALPH(7)),(IOO,ISCA(4)),(IFF,ISCA(6)),(IHH,IALPH(1)),
	1(ILL,IALPH(5)),(IPP,ISCA(2)),(ICC,ISCA),(IRR,IALPH(9)),
	1(ISS,ISCA(9)),(IHH,IALPH),(IUU,IALPH(10)),(III,IALPH(2))
1	FORMAT(80A1)
	ML=1
5	READ(23,1,END=2)M
	DO 3 K=80,1,-1
3 	IF(M(K).NE.IBLA)GO TO 4
	GO TO 5
4	DO 6 I=1,K
	L=M(I)
C PUT IN TRAP FOR TAB AND <
	L2=M(I+1)
	L3=M(I+2)
	L4=M(I+3)
	L5=M(I+4)
	IF(L.EQ.IBLA)GO TO 7
	IF(L.NE.IPP)GO TO 8
	IF(L2.NE.IRR)GO TO 16
	IF(L3.NE.IEE)GO TO 22
	IF(L4.NE.ICC)GO TO 22
	IF(L5.NE.IEE)GO TO 22
C NOW FOUND 'PRECEDE'
	KODE=7
	RETURN
16	IF(L2.NE.ILL)GO TO 22
	IF(L3.NE.IAA)GO TO 22
	IF(L4.NE.IYY)GO TO 22
	IF(L5.NE.IBLA)GO TO 22
C NOW FOUND 'PLAY' SECTION
	ML=6
	KODE=4
	RETURN
8	IF(L.NE.IRR)GO TO 10
	IF(L2.NE.IUU)GO TO 22
	IF(L3.NE.INN)GO TO 22
	IF(L4.NE.IBLA.AND.L4.NE.ISEMI)GO TO 22
C NOW FOUND 'RUN'
	KODE=2
	RETURN
10	IF(L.NE.ITT)GO TO 12
	IF(L2.NE.IEE)GO TO 22
	IF(L3.NE.IMM)GO TO 22
	IF(L4.NE.IPP)GO TO 22
	IF(L5.NE.IOO)GO TO 22
	DO 14 KK=I+5,K
14	IF(M(KK).EQ.KSLA)GO TO 15
15	ML=KK+1
C FOUND 'TEMPO'
	KODE=3
	RETURN
12	IF(L.NE.III)GO TO 17
	IF(L2.NE.INN)GO TO 22
	IF(L3.NE.ISS)GO TO 22
	IF(L4.NE.IEE)GO TO 22
	IF(L5.NE.IRR)GO TO 22
C FOUND 'INSERT'
 	ML=7
	KODE=5
	RETURN
17	IF(L.NE.IFF)GO TO 19
	IF(L2.NE.III)GO TO 22
	IF(L3.NE.INN)GO TO 22
	IF(L4.NE.III)GO TO 22
	IF(L5.NE.ISS)GO TO 22
C 'FINISH' IS SAME AS 'END SECTION'
	IF(I(K+5).NE.IHH)GO TO 22
21	KODE=6
	RETURN
19	IF(L.NE.IEE)GO TO 11
	IF(L2.NE.INN)GO TO 9 
	IF(L3.NE.IDD)GO TO 22
	IF(L4.NE.IBLA)GO TO 22
C 'END SECTION'
	IF(L5.EQ.ISS)GO TO 21
9	IF(L2.NE.IDD)GO TO 22
	IF(L3.NE.III)GO TO 22
	IF(L4.NE.ITT)GO TO 22
C FOUND 'EDIT'
	KODE=8
	RETURN
11	IF(L.NE.ISS)GO TO 22
	IF(L2.NE.IEE)GO TO 22
	IF(L3.NE.ICC)GO TO 22
	IF(L4.NE.ITT)GO TO 22
	IF(L5.NE.III)GO TO 22
C FOUND 'SECTION'
	KODE=9
	RETURN

C↓↓↓ NOW IT MUST BE AND INSTR. NAME.
22	DO 24 KK=I+1,K
	L=M(KK)
	IF(L.EQ.ISEMI)GO TO 25
24	IF(L.EQ.IBLA)GO TO 25
C***** HERE UP TO 4 CHARS WILL BE PACKED INTO 'J'
25	DO 26 JJ=KK,K
26	IF(M(JJ).EQ.ISEMI)GO TO 27
C IF NO SEMICOLON THEN ERROR
	CALL ERROR(1)
27	ML=JJ+1
	KODE=1
	GO TO (1,101,102,103,104)KK
C*** NEXT IS FOR PDP10 ONLY *****
201	FORMAT(A1,4F)
202	FORMAT(A2,4F)
203	FORMAT(A3,4F)
204	FORMAT(A4,4F)
101	REREAD 201,J,VV
	RETURN
102	REREAD 202,J,VV
	RETURN
103	REREAD 203,J,VV
	RETURN
104	REREAD 204,J,VV
	RETURN
	END